home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Utilities / Miscellaneous / CopyPaste 3.3.4 / CopyPaste Tools Sourcecode / 2Byte > 1 Byte / 2Byte > 1 Byte.p < prev    next >
Encoding:
Text File  |  1997-06-06  |  1.8 KB  |  75 lines  |  [TEXT/CWIE]
  1. {•This sourcecode is an example for creating a FKey coderesource with•}
  2. {•Metrowerks Pascal. It is copyrighted by Peter Hoerster and released•}
  3. {•for free use in any Shareware or Freeware product as a way to thank all•}
  4. {•programmers who share code snippets. You may put this sources on any•}
  5. {•CD ROM or any Archive Server but you may not sell it. •}
  6.  
  7. {• For comments please write to <hoerster@muenster.de>•}
  8.  
  9.  
  10. unit convert2byte1byte;
  11.  
  12. interface
  13.  
  14.     uses
  15.         Types, OSUtils, GestaltEqu, Script, notification, Resources, Events,
  16.          PascalA4, QuickDraw, ToolUtils, Memory, LowMem, Scrap;
  17.  
  18.  
  19.  
  20. {$MAIN}
  21.                         
  22.     procedure main;        
  23.  
  24. implementation
  25.  
  26.     procedure dopaste;
  27.     const
  28.         pastecode=2422;
  29.     var 
  30.         qel: EvQelPtr;
  31.     begin
  32.             if ppostevent(3, pastecode, qel) = noerr then
  33.             qel^.evtqmodifiers := cmdkey;
  34.     end;
  35.  
  36.  
  37.     procedure main;
  38.         const
  39.             step = 1000;
  40.         var
  41.             oldA4: LongInt;
  42.             myerr: oserr;
  43.             myclipsize, templongint: longint;
  44.             myclipHandle: handle;
  45.             mytemphandle: handle;
  46.             
  47.         
  48.     begin
  49.         oldA4 := SetCurrentA4;
  50.         myclipsize := GetScrap(nil, 'TEXT', templongint);
  51.         mycliphandle := Tempnewhandle(myclipsize,myerr);
  52.         if myerr=noerr then 
  53.             begin
  54.                 myclipsize := GetScraP(myclipHandle, 'TEXT', templongint);
  55.                 if myclipsize > 0 then
  56.                     begin
  57.                         mytemphandle := Tempnewhandle(myclipsize,myerr);
  58.                         myerr := transliterateText(mycliphandle, mytemphandle, smtransascii + smtransascii1, smMaskascii2, smcurrentscript);
  59.  
  60.                         if myerr = noerr then
  61.                         begin
  62.                             TempDisposeHandle(myCliphandle,myerr);
  63.                             myerr := ZeroScrap;
  64.                             myclipsize:=gethandlesize(mytemphandle);
  65.                             Temphlock(mytemphandle,myerr);
  66.                             myerr := putscrap(myclipsize, 'TEXT', mytemphandle^);
  67.                             Temphunlock(mytemphandle,myerr);
  68.                             dopaste;
  69.                         end;
  70.                     end;
  71.                 TempDisposeHandle(mytemphandle,myerr);
  72.             end;
  73.         oldA4 := SetA4(oldA4);
  74.     end;
  75. end.